home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Collections: Franz PD
/
Franz PD Disk #110 (1991-01)(Amiga User Group Deutschland e.V.).zip
/
Franz PD Disk #110 (1991-01)(Amiga User Group Deutschland e.V.).adf
/
Comic_Verwaltung
/
Installation
(
.txt
)
< prev
next >
Wrap
AmigaBASIC Source Code
|
1989-07-03
|
11KB
|
429 lines
DEFINT a-z
eingelesen=0
DECLARE FUNCTION Execute& LIBRARY
DECLARE FUNCTION xOpen& LIBRARY
5 ON ERROR GOTO 0
10 CLS:LOCATE 5,5:PRINT "Installation der Comicverwaltung"
20 LOCATE 8,5:PRINT "1. volle Installation"
30 LOCATE 10,5:PRINT "2. Druckervoreinstellung"
40 LOCATE 12,5:PRINT "3. Voreinstellung für Ausdruck"
50 LOCATE 14,5:PRINT "4. Anzahl der Zustände ändern"
LOCATE 16,5:PRINT "5. zusätzliche Diskette einrichten"
LOCATE 18,5:PRINT "6. Ende"
60 q$=INKEY$
70 IF q$<"1" OR q$>"6" THEN SLEEP:GOTO 60
70 ON VAL(q$) GOTO 100,200,300,400,500,80
80 SYSTEM
100 CLS
110 LOCATE 2,30:PRINT "Installation"
120 LOCATE 4,5:PRINT "Das Programm benötigt die dos.library."
130 LOCATE 5,5:PRINT "Geben Sie bitte den vollständigen Pfad dazu ein:"
140 INPUT lib$
150 IF UCASE$(RIGHT$(lib$,11))="DOS.LIBRARY" THEN lib$=LEFT$(lib$,LEN(lib$)-11
IF (RIGHT$(lib$,1)<>"/" AND RIGHT$(lib$,1)<>":")AND LEN(lib$)>0 THEN lib$=lib$+"/"
ON ERROR GOTO libfehler
LIBRARY lib$+"dos.library"
LOCATE 7,5:PRINT "Geben Sie jetzt bitte an, wo sich die Comicverwaltung"
LOCATE 8,5:PRINT "befindet (vollst. Pfad)."
ON ERROR GOTO fehler
cv: LOCATE 9,5:INPUT cvpfad$
IF cvpfad$="" THEN cv
IF (RIGHT$(cvpfad$,1)<>"/")AND(RIGHT$(cvpfad$,1)<>":")AND LEN(cvpfad$)>0 THEN cvpfad$=cvpfad$+"/"
fehler=0
OPEN cvpfad$+"Start" FOR INPUT AS 1 'comicprg----------------------
CLOSE 1
IF fehler THEN LOCATE 20,5:PRINT "Comicverwaltung nicht gefunden":GOTO cv
ON ERROR GOTO 0
LOCATE 10,5:PRINT "Geben Sie jetzt bitte an, wo die Comicverwaltung installiert"
LOCATE 11,5:PRINT "werden soll (vollst. Pfad)."
GOSUB pfadeingabe
LOCATE 13,5:PRINT "Welches Laufwerk soll für Zwischenspeicherungen verwendet werden"
LOCATE 14,5:PRINT " (RAM: oder RAD:) ? "
155 LOCATE 14,27:INPUT lw$
lw$=UCASE$(lw$)
IF lw$<>"RAM:" AND lw$<>"RAD:" THEN
LOCATE 15,5:PRINT "Wirklich "lw$" (j/n)?"
q$=""
WHILE q$<>"j" AND q$<>"n"
SLEEP:q$=INKEY$
WEND
IF q$="n" THEN 155
END IF
ON ERROR GOTO 0
fHandle& = xOpen&(SADD("con:0/0/600/100/"+CHR$(0)),1005)
IF fHandle& = 0 THEN PRINT:PRINT "Fehler im DOS":taste:LIBRARY CLOSE:GOTO 10
x=Execute&(SADD("makedir "+cpfad$+"comp"+CHR$(0)), 0,fHandle&)
x=Execute&(SADD("makedir "+cpfad$+"comdat"+CHR$(0)), 0,fHandle&)
x=Execute&(SADD("copy "+cvpfad$+"comic.haupt "+cpfad$+"comic.haupt"+CHR$(0)), 0,fHandle&)
x=Execute&(SADD("copy "+cvpfad$+"start "+cpfad$+"start"+CHR$(0)), 0,fHandle&)
x=Execute&(SADD("copy "+cvpfad$+"start.info "+cpfad$+"start.info"+CHR$(0)), 0,fHandle&)
pfad$=cpfad$+"comp/"
CALL xClose&(fHandle&)
LIBRARY CLOSE
LOCATE 16,5:PRINT "Vor der Neuanlage müssen Sie noch festlegen, wieviele verschiedene"
LOCATE 17,5:PRINT "Zustände Sie unterscheiden wollen (1-10) :"
170 LOCATE 17,48:INPUT "",zmax$
zmax!=VAL(zmax$):IF zmax! < 1 OR zmax! > 10 OR INT(zmax!)<> zmax! THEN 170
zmax=VAL(zmax$)
OPEN pfad$+"Zahlen" AS 1 LEN=2
FIELD 1,2 AS d$
LSET d$=MKI$(0):PUT 1,1
LSET d$=MKI$(zmax):PUT 1
CLOSE 1
OPEN pfad$+"Titel" AS 1 LEN=34
FIELD 1,34 AS d$
LSET d$=" ":PUT 1,1
CLOSE 1
OPEN pfad$+"Index" AS 1 LEN=2
FIELD 1,2 AS d$
LSET d$=MKI$(0):PUT 1,1
CLOSE 1
OPEN pfad$+"Voreinstellung" AS 1 LEN=1
FIELD 1,1 AS d$
d$=CHR$(0):PUT 1,1
CLOSE 1
GOSUB drucker
GOSUB ausdruck
GOTO 10
libfehler:
PRINT "Die dos.library wurde nicht gefunden. (Taste)"
taste
RESUME 5
pfadfehler:
LOCATE 23,5:PRINT "ungültiger Pfad"
RESUME pfadeingabe
fehler:
fehler=ERR
RESUME NEXT
SUB taste STATIC
rq$=""
WHILE rq$=""
SLEEP:rq$=INKEY$
WEND
END SUB
drucker:
OPEN pfad$+"Drucker" FOR OUTPUT AS 1
PRINT #1,cpfad$
PRINT #1,lib$
PRINT #1,lw$
PRINT #1,CHR$(34)+CHR$(27)+CHR$(64)+CHR$(17)+CHR$(34)
PRINT #1,CHR$(34)+CHR$(10)+CHR$(34)
PRINT #1,CHR$(34)+CHR$(27)+CHR$(77)+CHR$(27)+CHR$(15)+CHR$(34)
PRINT #1,CHR$(34)+"PAR:"+CHR$(34)
PRINT #1,MKI$(72);
PRINT #1,MKI$(72);
PRINT #1,MKI$(160)
CLOSE 1
RETURN
daten:
DATA "Vorhandene",1,"<<",">> ",,
DATA "Fehlende",0,"<<",">> ",,
DATA "Mehrfache",5,"<<",">> ",,
DATA "Vorhandene zusammengefaßt",9,"<<",">> ",,
DATA "Vorhandene mit Zustand",17,"<<",">> ",,
DATA "Vorhandene zus. mit Zustand",33,"<<",">> ",,
DATA "Alle",3,"<<",">> ",(,)
DATA "Alle mit Zustand",19,"<<",">> ",(,)
DATA "Alle zus. mit Zustand",35,"<<",">> ",(,)
ausdruck:
OPEN pfad$+"Druckart" AS 1 LEN=107
FIELD 1,30 AS d$,1 AS bed$,1 AS lg$,5 AS t1$,5 AS t2$,1 AS lg2$,5 AS t3$,5 AS t4$,4 AS lg3$,50 AS t5$
RESTORE daten
FOR i=0 TO 8
READ q$:LSET d$=q$
READ q:LSET bed$=CHR$(q)
READ q$:LSET t1$=q$:q=LEN(q$)
READ q$:LSET t2$=q$:q=q*16+LEN(q$)
LSET lg$=CHR$(q)
READ q$:LSET t3$=q$:q=LEN(q$)
READ q$:LSET t4$=q$:q=16*q+LEN(q$)
LSET lg2$=CHR$(q)
IF i=5 OR i=8 THEN
LSET lg3$=MKL$(153391689)
LSET t5$="0 1 2 3 4 5 6 7 8 9 "
END IF
PUT 1,i+1
NEXT
CLOSE 1
RESET
RETURN
200 CLS:fehler=0:cpfad$="":i=0:lw$=""
210 ON ERROR GOTO fehler
OPEN cpfad$+"comp/Drucker" FOR INPUT AS 1
IF fehler>0 AND i=0 THEN
i=1
211 LOCATE 5,5:PRINT "Bitte geben Sie den vollst. Pfad zur Comicverwaltung an :"
GOSUB pfadeingabe
IF INSTR(cpfad$,":")=0 THEN 211
fehler=0:ON ERROR GOTO fehler
OPEN cpfad$+"comp/Index" FOR INPUT AS 1
CLOSE 1
IF fehler>0 THEN LOCATE 20,5:"falscher Pfad (Taste)":taste:GOTO 211
GOTO 210
ELSEIF fehler>0 AND i=1 THEN
LOCATE 8,5:PRINT "Bitte den Pfad zur DOS.LIBRARY angeben"
INPUT lib$
IF UCASE$(RIGHT$(lib$,11))="DOS.LIBRARY" THEN lib$=LEFT$(lib$,LEN(lib$)-11)
IF (RIGHT$(lib$,1)<>"/" AND RIGHT$(lib$,1)<>":")AND LEN(lib$)>0 THEN lib$=lib$+"/"
ON ERROR GOTO libfehler
LIBRARY lib$+"dos.library"
LIBRARY CLOSE
ELSE
INPUT#1,cpfad$
INPUT#1,lib$
INPUT#1,lw$
CLOSE 1
END IF
LOCATE 10,1:PRINT "Welches Laufwerk soll für Zwischenspeicherungen verwendet werden"
LOCATE 11,1:PRINT "(RAM: oder RAD:) ? "
IF lw$<>"" THEN LOCATE 11,21:PRINT "CR = ";lw$
q$=""
215 INPUT q$
IF q$<>"" THEN lw$=q$
lw$=UCASE$(lw$)
IF lw$<>"RAM:" AND lw$<>"RAD:" THEN
LOCATE 12,5:PRINT "Wirklich "lw$" (j/n)?"
q$=""
WHILE q$<>"j" AND q$<>"n"
SLEEP:q$=INKEY$
WEND
IF q$="n" THEN 215
END IF
pfad$=cpfad$+"comp/"
GOSUB drucker
GOTO 5
pfadeingabe:
ON ERROR GOTO pfadfehler
INPUT cpfad$
IF (RIGHT$(cpfad$,1)<>"/")AND(RIGHT$(cpfad$,1)<>":")AND LEN(cpfad$)>0 THEN cpfad$=cpfad$+"/"
dum:
OPEN cpfad$+"com.dummy" FOR OUTPUT AS 1
CLOSE 1
KILL cpfad$+"com.dummy"
ON ERROR GOTO 0
RETURN
300 CLS
LOCATE 5,5:PRINT "Bitte geben Sie ein, wohin die Voreinstellung kopiert"
LOCATE 6,5:PRINT "werden soll :"
GOSUB pfadeingabe
IF UCASE$(RIGHT$(cpfad$,5))="COMP/" THEN
pfad$=cpfad$
ELSE
pfad$=cpfad$
IF RIGHT$(pfad$,1)<>":" AND RIGHT$(pfad$,1)<>"/" AND LEN(pfad$)>0 THEN pfad$=pfad$+"/"
pfad$=pfad$+"comp/"
END IF
ON ERROR GOTO fehler:fehler=0
OPEN cpfad$+"com.dummy" FOR OUTPUT AS 1
IF fehler>0 THEN LOCATE 20,5:PRINT "Unterverzeichnis nicht gefunden (Taste)":taste:GOTO 5
CLOSE 1
KILL cpfad$+"com.dummy"
ON ERROR GOTO 0
GOSUB ausdruck
GOTO 10
400 CLS
IF NOT eingelesen THEN
DIM dec(83),cod(43),dat(10),ndat(10),nz(10)
RESTORE cod
FOR i=0 TO 43:READ q$:cod(i)=VAL("&h"+q$):NEXT i
FOR i=0 TO 83:READ q$:dec(i)=VAL("&h"+q$):NEXT i
eingelesen=-1
END IF
LOCATE 5,5:PRINT "Bitte geben Sie den Pfad zum Comicprogramm ein."
GOSUB pfadeingabe
ON ERROR GOTO fehler:fehler=0
OPEN cpfad$+"comp/Zahlen" FOR INPUT AS 1
CLOSE 1
q=fehler
OPEN cpfad$+"comp/Titel" FOR INPUT AS 1
CLOSE 1
IF q+fehler>0 THEN LOCATE 20,5:PRINT "Dateien nicht gefunden (Taste)":taste:GOTO 5
ON ERROR GOTO 0
OPEN cpfad$+"comp/Zahlen" AS 1 LEN=2
FIELD 1,2 AS d$
GET 1,1:an=CVI(d$):GET 1:zmax=CVI(d$):satzl=(zmax+2)\2
IF an=0 THEN CLOSE 1:GOTO 10
CLS
LOCATE 3,5:PRINT "Wieviele Zustände werden gewünscht (1-10) ?"
nzmax=0
WHILE nzmax<1 OR nzmax>10 OR nzmax=zmax
LOCATE 3,50:INPUT nzmax
WEND
nsatzl=(nzmax+2)\2
LOCATE 4,5:PRINT "Ordnen Sie jetzt den alten Zuständen je einen neuen zu"
LOCATE 5,5:PRINT "alter Zustand neuer Zustand"
FOR i=0 TO zmax-1
LOCATE 6+i,10:PRINT i
nz(i)=-1
WHILE nz(i)<0 OR nz(i)>=nzmax
LOCATE 6+i,18:INPUT nz(i)
WEND
NEXT i
OPEN cpfad$+"comp/Zahlen.neu" AS 2 LEN=2
FIELD 2,2 AS d2$
LSET d2$=MKI$(an):PUT 2,1
LSET d2$=MKI$(nzmax):PUT 2,2
FOR i=1 TO an
FOR j=0 TO nzmax-1:z(j)=0:NEXT j
FOR j=0 TO zmax-1
GET 1,(i-1)*(zmax+2)+j+3:z(nz(j))=z(nz(j))+CVI(d$)
NEXT j
FOR j=0 TO nzmax-1
LSET d2$=MKI$(z(j)):PUT 2
NEXT j
GET 1:LSET d2$=d$:PUT 2
GET 1:LSET d2$=d$:PUT 2
NEXT i
CLOSE 1
CLOSE 2
pfad$=cpfad$+"comdat/"
OPEN cpfad$+"comp/Titel" AS 1 LEN=34
FIELD 1,1 AS laenge$,30 AS d$,1 AS jahr$,2 AS mnr$
nummer=0
FOR i=1 TO an
GET 1,i:t$=LEFT$(d$,ASC(laenge$))
LOCATE 18,5:PRINT USING "\ \";t$
pf: ON ERROR GOTO fehler:fehler=0
OPEN pfad$+t$ FOR INPUT AS 2
CLOSE 2
ON ERROR GOTO 0
IF fehler>0 THEN
LOCATE 20,5:PRINT "Datei nicht gefunden"
LOCATE 21,5:PRINT "bitte den richtigen Pfad eingeben :":INPUT pfad$
IF RIGHT$(pfad$,1)="/" THEN pfad$=LEFT$(pfad$,LEN(pfad$)-1)
IF RIGHT$(pfad$,6)<>"comdat" THEN
IF RIGHT$(pfad$,1)<>":" THEN pfad$=pfad$+"/"
pfad$=pfad$+"comdat"
END IF
pfad$=pfad$+"/"
GOTO pf
END IF
OPEN pfad$+t$ AS 2 LEN=satzl
FIELD 2,satzl AS d2$
IF LEN(t$)<26 THEN
OPEN pfad$+t$+".neu" AS 3 LEN=nsatzl
ELSE
OPEN pfad$+"xxyyzzy"+STR$(nummer) AS 3 LEN=nsatzl
nummer=nummer+1
END IF
FIELD 3,nsatzl AS d3$
l=LOF(2)/satzl
FOR j=1 TO l
GET 2,j
decodiere d2$
FOR k=1 TO nzmax:ndat(k)=0:NEXT k
ndat(0)=dat(0)
IF ndat(0)=0 THEN
FOR k=0 TO zmax-1
ndat(nz(k)+1)=ndat(nz(k)+1)+dat(k+1)
NEXT k
codiere q$
LSET d3$=q$
ELSE
LSET d3$=CHR$(240)+STRING$(nsatzl-1,0)
END IF
PUT 3,j
NEXT j
CLOSE 2:CLOSE 3
NEXT i
CLOSE 1
KILL cpfad$+"comp/Zahlen"
NAME cpfad$+"comp/Zahlen.neu" AS "comp/Zahlen"
OPEN cpfad$+"comp/Titel" AS 1 LEN=34
FIELD 1,1 AS laenge$,30 AS d$,1 AS jahr$,2 AS mnr$
nummer=0
FOR i=1 TO an
GET 1,i:t$=LEFT$(d$,ASC(laenge$))
KILL pfad$+t$
IF LEN(t$)<26 THEN
NAME pfad$+t$+".neu" AS pfad$+t$
ELSE
NAME pfad$+"xxyyzzy"+STR$(nummer) AS pfad$+t$
nummer=nummer+1
END IF
q$=LEFT$(t$+".info",30)
ON ERROR GOTO fehler
IF q$<>t$ THEN KILL pfad$+t$+".info"
ON ERROR GOTO 0
NEXT i
CLOSE 1
ON ERROR GOTO fehler
FOR i=0 TO nummer
KILL pfad$+"xxyyzzy"+STR$(i)+".info"
NEXT i
ON ERROR GOTO 0
GOTO 5
cod:
DATA 0000,0000,0000,0011,0000,03E9,0000,0011
DATA 48E7,F0C0,206F,001C,226F,0020,222F,0024
DATA 5341,E249,6500,0006,343C,0001,3019,E988
DATA 3619,0243,000F,D003,10C0,51C9,FFF0,0802
DATA 0000,6600,0008,3011,E948,1080,4CDF,030F
DATA 4E75,4E71,0000,03F2
REM decode
DATA 0000,0000,0000,0025,0000,03E9,0000,0025
DATA 48E7,F8F0,206F,0028,226F,002C,246F,0030
DATA 222F,0034,266F,0038,1010,0200,00F0,6600
DATA 0070,78FF,7400,5341,E249,6500,0006,343C
DATA 0001,7600,1018,E898,0240,000F,34C0,0C43
DATA 0000,6600,000C,0C00,0000,6600,0004,5284
DATA D640,E998,0240,000F,34C0,0C43,0000,6600
DATA 000C,0C40,0000,6600,0004,5284,D640,51C9
DATA FFC4,0802,0000,6600,000E,1010,E808,0240
DATA 000F,3480,D640,3283,3684,4CDF,0F1F,4E75
DATA 3480,60F6,0000,03F2
SUB decodiere(t$) STATIC
SHARED dec(),dat(),zmax,geszahl,bestZust
IF t$<>"" THEN
geszahl=0:bestZust=0
ass&=0
Adr&=0
gadr&=0
dadr&=0
bzadr&=0
Adr&=SADD(t$)
gadr&=VARPTR(geszahl)
dadr&=VARPTR(dat(0))
bzadr&=VARPTR(bestZust)
ass&=VARPTR(dec(0))
CALL ass&(Adr&,gadr&,dadr&,zmax,bzadr&)
END IF
END SUB
SUB codiere(t$) STATIC
SHARED cod(),ndat(),nzmax,nsatzl
t$=STRING$(nsatzl,0)
ass&=0
Adr&=0
dadr&=0
Adr&=SADD(t$)
dadr&=VARPTR(ndat(0))
ass&=VARPTR(cod(0))
CALL ass&(Adr&,dadr&,nzmax)
END SUB
500
CLS
LOCATE 2,30:PRINT "neue Diskette einrichten"
LOCATE 4,5:PRINT "Geben Sie bitte den vollständigen Pfad zur dos.library an:"
INPUT lib$
IF UCASE$(RIGHT$(lib$,11))="DOS.LIBRARY" THEN lib$=LEFT$(lib$,LEN(lib$)-11
IF (RIGHT$(lib$,1)<>"/" AND RIGHT$(lib$,1)<>":")AND LEN(lib$)>0 THEN lib$=lib$+"/"
ON ERROR GOTO libfehler
LIBRARY lib$+"dos.library"
ON ERROR GOTO 0
LOCATE 6,5:PRINT "Legen Sie jetzt bitte eine formatierte Diskette ein (+ Taste)."
taste
fHandle& = xOpen&(SADD("con:0/0/600/100/"+CHR$(0)),1005)
IF fHandle& = 0 THEN PRINT:PRINT "Fehler im DOS":taste:LIBRARY CLOSE:GOTO 10
x=Execute&(SADD("makedir df0:comdat"+CHR$(0)), 0,fHandle&)
CALL xClose&(fHandle&)
LIBRARY CLOSE
GOTO 10